Rideshare in Chicago During COVID-19
April 06, 2021
Trips Over Time
Daily Trips
# Import data
daily_trips <- dbGetQuery(con, "SELECT * FROM analysis.daily_trips")
# Clean and tidy
daily_trips <- daily_trips %>%
mutate("year" = year(date),
"day" = yday(date),
"date_x" = date %>%
as.character(.) %>%
str_replace("^\\d{4}","2000") %>%
as_date(.),
"weekday" = wday(date, label = TRUE),
"trips" = as.numeric(trips)) # Plot information
daily_trips_plot_title <- daily_trips %>%
group_by(year) %>%
summarize(trips = sum(trips)) %>%
pivot_wider(everything(), names_from = "year", values_from = "trips") %>%
mutate("change" = `2020`-`2019`,
"change_pct" = (change/`2019`),
"title_text" = paste0(as.character(comma(-change)),
" (", percent(change_pct), ")"))
# Daily trips YoY plot
gg_daily_trips <- daily_trips %>%
group_by(year) %>%
arrange(date_x) %>%
mutate(trips_agg = cumsum(trips)) %>%
ggplot(aes(x = date_x, y = trips_agg, color = as.character(year))) +
geom_line(size = 1.5) +
geom_vline(xintercept = as.numeric(as.Date("2000-03-21")),
linetype = 4, color = "black", size = 1) +
scale_x_date(date_breaks = "1 month",
date_labels = "%b-%d") +
scale_y_continuous(labels = comma,
limits = c(0, NA)) +
labs(title = paste0("Compared to the same period in 2019 (1/1-9/30),\nrideshare trips have decreased by ",
daily_trips_plot_title$title_text, " in 2020"),
x = "Day of the Year", y = "Aggregate Trips",
color = "Year") +
scale_color_ipsum() +
theme_ipsum()
# Interactive plot
ggplotly(gg_daily_trips)Prior to Governor Pritzker’s Stay-at-Home Order going into effect on March 21st, trips were already down by about 7 percent year-over-year. However, the bulk of the decline in rideshare occurred over the spring and summer. From late March to October, only 17 million rideshare trips were taken in Chicago, a 71 percent decline compared to 2019.
# Pre/Post COVID table
daily_trips %>%
mutate("covid_group" = ifelse(date_x >= "2000-03-21",
"Post-COVID",
"Pre-COVID")) %>%
mutate("covid_group" = factor(covid_group,
levels = c("Pre-COVID",
"Post-COVID"))) %>%
group_by(covid_group, year) %>%
summarize(trips = sum(trips)) %>%
ungroup() %>%
pivot_wider(names_from = "year",
values_from = "trips") %>%
adorn_totals("row") %>%
mutate("change" = `2020`-`2019`,
"change_pct" = (change/`2019`)) %>%
mutate(across(c(`2019`, `2020`, change), comma),
"change_pct" = percent(change_pct)) %>%
select("Period" = covid_group, `2019`, `2020`,
"Change" = change, "Change (%)" = change_pct) %>%
kbl() %>%
row_spec(3, bold = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover",
"condensed", "responsive"))| Period | 2019 | 2020 | Change | Change (%) |
|---|---|---|---|---|
| Pre-COVID | 24,413,752 | 22,610,225 | -1,803,527 | -7% |
| Post-COVID | 59,148,536 | 17,161,435 | -41,987,101 | -71% |
| Total | 83,562,288 | 39,771,660 | -43,790,628 | -52% |
Monthly Trips
# Import data
monthly_trips <- dbGetQuery(con, "SELECT * FROM analysis.monthly_trips")
# Clean and tidy
monthly_trips <- monthly_trips %>%
mutate("year" = year(month),
"date_x" = floor_date(month, unit = "month") %>%
as.character(.) %>%
str_replace("^\\d{4}","2000") %>%
as_date(.),
"month" = month(month, label = TRUE, abbr = TRUE),
"trips" = as.numeric(trips)) Taking a step back to examine trips per month, rideshare trips reached a low of 1.5 million in April. While trips rebounded in the following months, they have hovered around 3.5 million from July through September.
# Monthly trips YoY plot
gg_monthly_trips <- monthly_trips %>%
ggplot(aes(x = date_x, y = trips, fill = as.character(year))) +
geom_bar(stat = "identity", color = "black",
position = position_dodge(width = 25), width = 20) +
scale_x_date(date_breaks = "1 month", date_labels = "%b") +
scale_y_continuous(labels = comma) +
labs(title = paste0("Trips per Month declined significantly in March,\nbottoming out at 1.5 million in April"),
x = "Month", y = "Trips",
fill = "Year") +
scale_fill_ipsum() +
theme_ipsum()
# Interactive plot
ggplotly(gg_monthly_trips)Trip Changes Surrounding 3/31/20 Stay-at-Home Order
It is clear that behavior changed in March even before the Stay-at-Home Order, as trips per day decreased significantly after Saturday, March 14th, 2020, a full week before the Order went into effect.
# Trips per day YoY plot
gg_trips_per_day <- daily_trips %>%
filter(month(date, label = TRUE) %in% c("Feb", "Mar")) %>%
group_by(year) %>%
arrange(date_x) %>%
ggplot(aes(x = date_x, y = trips, color = as.character(year))) +
geom_line(size = 1.5) +
geom_vline(xintercept = as.numeric(as.Date("2000-03-21")),
linetype = 4, color = "black", size = 1) +
scale_x_date(date_breaks = "1 week",
date_labels = "%b-%d") +
scale_y_continuous(labels = comma,
limits = c(0, NA)) +
labs(title = paste0("Trips per Day fell before the Stay-at-Home Order went into effect,\n peaking at 360,000 trips on Saturday, March 14th, 2020"),
x = "Day of the Year", y = "Trips per Day",
color = "Year") +
scale_color_ipsum() +
theme_ipsum()
# Interactive plot
ggplotly(gg_trips_per_day)Trips by Hour and Day of the Week
# Day of week YoY plot
# Pre/Post COVID table
gg_day_of_week_trips <- daily_trips %>%
mutate("covid_group" = ifelse(date_x >= "2000-03-21", "Post-COVID", "Pre-COVID")) %>%
mutate("covid_group" = factor(covid_group,
levels = c("Pre-COVID", "Post-COVID"))) %>%
group_by(covid_group, year, weekday) %>%
summarize(trips = sum(trips)) %>%
ungroup() %>%
ggplot(aes(x = weekday, y = trips, fill = as.character(year))) +
geom_bar(stat = "identity", color = "black") +
# scale_x_date(date_breaks = "1 month", date_labels = "%b") +
scale_y_continuous(labels = comma) +
labs(title = paste0("Trips per Day of Week, Pre/Post-COVID"),
x = "Month", y = "Trips",
fill = "Year") +
facet_grid(covid_group ~ year) +
scale_fill_ipsum() +
theme_ipsum()
# Interactive plot
ggplotly(gg_day_of_week_trips)Trip Characteristics
# Import data
trip_chars_avg <- dbGetQuery(con, "SELECT * FROM analysis.tnp_trip_chars") %>%
mutate("covid_group" = factor(covid_group,
levels = c("Pre-COVID", "Post-COVID")),
"trips" = as.numeric(trips)) %>%
arrange(covid_group, year)Distance
Average distance of trips in miles:
# Average distance
# Pre/Post COVID table
trip_chars_avg %>%
select(covid_group, year, trip_miles) %>%
pivot_wider(names_from = "year",
values_from = "trip_miles") %>%
mutate("change" = `2020`-`2019`,
"change_pct" = (change/`2019`)) %>%
mutate(across(c(`2019`, `2020`, change), comma),
"change_pct" = percent(change_pct)) %>%
select("Period" = covid_group, `2019`, `2020`,
"Change" = change, "Change (%)" = change_pct) %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover",
"condensed", "responsive"))| Period | 2019 | 2020 | Change | Change (%) |
|---|---|---|---|---|
| Pre-COVID | 5.86 | 6.394 | 0.53 | 9.0% |
| Post-COVID | 6.36 | 6.486 | 0.13 | 2.1% |
Time
Average time of trips in minutes:
# Average time - minutes
# Pre/Post COVID table
trip_chars_avg %>%
mutate("trip_minutes" = trip_seconds / 60) %>%
select(covid_group, year, trip_minutes) %>%
pivot_wider(names_from = "year",
values_from = "trip_minutes") %>%
mutate("change" = `2020`-`2019`,
"change_pct" = (change/`2019`)) %>%
mutate(across(c(`2019`, `2020`, change), comma),
"change_pct" = percent(change_pct)) %>%
select("Period" = covid_group, `2019`, `2020`,
"Change" = change, "Change (%)" = change_pct) %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover",
"condensed", "responsive"))| Period | 2019 | 2020 | Change | Change (%) |
|---|---|---|---|---|
| Pre-COVID | 17.5 | 16.9 | -0.6 | -3% |
| Post-COVID | 18.8 | 15.8 | -3.0 | -16% |
Fares
# Import data
fares <- dbGetQuery(con, "SELECT * FROM analysis.tnp_fares") %>%
mutate("covid_group" = factor(covid_group,
levels = c("Pre-COVID", "Post-COVID")),
"trips" = as.numeric(trips))
# Distribution of fares
fares_pct <- fares %>%
group_by(covid_group, year) %>%
arrange(year, covid_group, fare) %>%
mutate("trips_pct" = trips / sum(trips),
"trips_pct_agg" = cumsum(trips_pct)) %>%
ungroup()
# 95% of trips in all periods <$30 dollars
fares_tail <- fares_pct %>%
group_by(covid_group, year) %>%
filter(trips_pct_agg < 0.95) %>%
arrange(desc(fare)) %>%
slice(1) %>%
ungroup()
# Average fares
# Pre/Post COVID table
trip_chars_avg %>%
select(covid_group, year, fare) %>%
pivot_wider(names_from = "year",
values_from = "fare") %>%
mutate("change" = `2020`-`2019`,
"change_pct" = (change/`2019`)) %>%
mutate(across(c(`2019`, `2020`, change), dollar),
"change_pct" = percent(change_pct)) %>%
select("Period" = covid_group, `2019`, `2020`,
"Change" = change, "Change (%)" = change_pct) %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover",
"condensed", "responsive"))| Period | 2019 | 2020 | Change | Change (%) |
|---|---|---|---|---|
| Pre-COVID | $10.79 | $11.59 | $0.80 | 7.4% |
| Post-COVID | $12.35 | $12.22 | -$0.12 | -1.0% |
# Histogram
gg_fares <- fares %>%
ggplot(aes(x = fare, y = trips, fill = as.character(year))) +
geom_bar(stat = "identity", color = "black") +
geom_vline(data = trip_chars_avg,
mapping = aes(xintercept = fare),
linetype = "dashed", size = 1) +
scale_x_continuous(labels = dollar_format(prefix = "$"),
limits = c(0, max(fares_tail$fare))) +
scale_y_continuous(labels = comma) +
labs(title = paste0("Fare Distribution, Pre/Post-COVID"),
subtitle = "95% of trip fares were less than $30 in each period",
x = "Fare", y = "Trips",
fill = "Year") +
facet_grid(covid_group ~ year) +
scale_fill_ipsum() +
theme_ipsum()
# Interactive plot
ggplotly(gg_fares)Spatial Distribution of Trips
Origin
# Import data
origin_tracts_comp <- dbGetQuery(con, "SELECT * FROM analysis.pickup_tracts_comp")
sf_tracts <- st_read(con, layer = "spatial_tracts")
acs_data_profiles <- dbGetQuery(con, "SELECT * FROM public.acs_data_profiles")
# Join trip data to spatial, reconfigure
origin_tracts_comp <- left_join(sf_tracts %>% select(GEOID),
origin_tracts_comp,
by = c("GEOID" = "pickup_census_tract")) %>%
st_as_sf() %>%
mutate("trips" = as.numeric(trips),
"covid_group" = factor(covid_group,
levels = c("Pre-COVID", "Post-COVID"))) %>%
arrange(covid_group, GEOID)
# Create essential worker definition
# National averages:
# -Essential: 23.8%
# -Healthcare: 9.5%
# Tract averages:
# -Essential: 418 (26.5%)
# -Healthcare: 148 (9.1%)
# Tract median (50th):
# -Essential: 353 (26.1%)
# -Healthcare: 115 (8.1%)
# Tract first quintile (80th):
# -Essential: 610 (33.9%)
# -Healthcare: 214 (12.6%)
acs_data_profiles <- acs_data_profiles %>%
filter(table_name == "S2401") %>%
select(GEOID, variable, estimate) %>%
pivot_wider(names_from = "variable",
values_from = "estimate") %>%
mutate("essential" = select(., S2401_C01_015:S2401_C01_025) %>%
rowSums(na.rm = TRUE),
"essential_pct" = essential / S2401_C01_001,
"health_all" = select(., S2401_C01_015:S2401_C01_019) %>%
rowSums(na.rm = TRUE),
"health_all_pct" = health_all / S2401_C01_001) %>%
rename("total" = S2401_C01_001,
"health_pract" = S2401_C01_015,
"health_support" = S2401_C01_019,
"police_fire" = S2401_C01_020,
"food_service" = S2401_C01_023,
"custodial" = S2401_C01_024,
"personal_service" = S2401_C01_025)
# Essential workers by tract
essential_workers_sf <- left_join(sf_tracts %>% select(GEOID),
acs_data_profiles,
by = "GEOID")In the Pre-COVID period (1/1-3/21) the spatial distribution of rideshare pickups and dropoffs in 2019 and 2020 were very similar. After the Stay-at-Home Order went into effect, however, trips cratered, particularly those originating on the South, West, and Northwest Sides. Even the core area of high trip activity, roughly comprising the Loop and the North Side, shrunk in size.
Census tracts where more than 33% of workers are essential are outlined in white, comprising the top 20 percent of tracts in the city. “Essential workers” are defined as healthcare practitioners and technical occupations, healthcare support occupations, protective service occupations,food preparation and serving related occupations, building and grounds cleaning and maintenance occupations, and personal care and service occupations. Neighborhoods with a high concentration of essential workers, especially those on the South and West Sides, saw a large decrease in trips.
# Map
# origin_tracts_comp %>%
# ggplot(aes(fill = trips)) +
# facet_wrap(~year) +
# geom_sf(color = "light gray") +
# coord_sf(crs = 4326) +
# scale_fill_viridis_c(labels = comma) +
# labs(title = "Rideshare Trips by Origin Census Tract") +
# theme_ipsum()
# Quantile map
tm_shape(origin_tracts_comp) +
tm_fill(col = "trips", title = "Trips",
style = "quantile", palette = "viridis") +
tm_borders() +
tm_facets(by = c("covid_group", "year"),
free.coords = FALSE,
drop.units = TRUE) +
tm_shape(essential_workers_sf %>%
filter(essential_pct >= quantile(essential_pct,
0.80,
na.rm = TRUE))) +
tm_borders(col = "white", lwd = 2) +
tm_layout(main.title = "Rideshare Trips by Origin Census Tract",
main.title.position = c("center"),
legend.outside = FALSE,
legend.position = c("left", "bottom"),
legend.width = 1.5,
scale = 2.75)
Destinations
# Import data
destination_tracts_comp <- dbGetQuery(con, "SELECT * FROM analysis.dropoff_tracts_comp")
# Join tabular to spatial, reconfigure
destination_tracts_comp <- left_join(sf_tracts %>% select(GEOID),
destination_tracts_comp,
by = c("GEOID" = "dropoff_census_tract")) %>%
st_as_sf() %>%
mutate("trips" = as.numeric(trips),
"covid_group" = factor(covid_group,
levels = c("Pre-COVID",
"Post-COVID"))) %>%
arrange(covid_group, GEOID)# Map
# destination_tracts_comp %>%
# ggplot(aes(fill = trips)) +
# facet_wrap(~year) +
# geom_sf(color = "light gray") +
# coord_sf(crs = 4326) +
# scale_fill_viridis_c(labels = comma) +
# labs(title = "Rideshare Trips by Destination Census Tract") +
# theme_ipsum()
# Quantile map
tm_shape(destination_tracts_comp) +
tm_fill(col = "trips", title = "Trips",
style = "quantile", palette = "viridis") +
tm_borders() +
tm_facets(by = c("covid_group", "year"),
free.coords = FALSE,
drop.units = TRUE) +
tm_shape(essential_workers_sf %>%
filter(essential_pct >= quantile(essential_pct,
0.80,
na.rm = TRUE))) +
tm_borders(col = "white", lwd = 2) +
tm_layout(main.title = "Rideshare Trips by Destination Census Tract",
main.title.position = c("center"),
legend.outside = FALSE,
legend.position = c("left", "bottom"),
legend.width = 1.5,
scale = 2.75)
Origin-Destination (OD) Flows
# Import data
od_pairs_raw <- dbGetQuery(con, "SELECT * FROM analysis.trip_patterns_tracts_comp") %>%
mutate("covid_group" = factor(covid_group,
levels = c("Pre-COVID", "Post-COVID")),
"trips" = as.numeric(trips))
# Intra- vs inter-tract pairs
od_pairs_intra_inter <- od_pairs_raw %>%
mutate("intra_inter" = case_when(pickup_census_tract ==
dropoff_census_tract ~
"Intra (Within Same Tract)",
pickup_census_tract !=
dropoff_census_tract ~
"Inter (Different Tract)")) %>%
group_by(covid_group, year, intra_inter) %>%
summarize("trips" = sum(trips)) %>%
ungroup()
# Remove intra-tract trips, make sure in Chicago
# reorganize columns to convert to desire lines
od_pairs_comp <- od_pairs_raw %>%
filter(pickup_census_tract != dropoff_census_tract,
pickup_census_tract %in% sf_tracts$GEOID,
dropoff_census_tract %in% sf_tracts$GEOID) %>%
select(pickup_census_tract, dropoff_census_tract,
everything()) %>%
od2line(flow = ., zones = sf_tracts)
# Create a linewidth variable to scale desire lines
od_pairs_comp <- od_pairs_comp %>%
mutate("lwd" = trips / mean(od_pairs_comp$trips)) %>%
relocate(lwd, .after = trips)Flow Types
Before analyzing trip flows, it is important to distinguish between those trips that begin and end within the same tract (intra-flows) and trips that begin and end in different tracts (inter-flows). As seen in the table below, very few rideshare trips started and ended in the same tract. About 1.5% of all trips were intra-flows. This was relatively consistent across years and time periods.
# OD Pairs Intra vs Inter
# Pre/Post-COVID table
od_pairs_intra_inter %>%
pivot_wider(names_from = c("year", "covid_group"),
values_from = "trips") %>%
adorn_totals(c("row", "col")) %>%
adorn_percentages("col") %>%
adorn_pct_formatting() %>%
kbl(col.names = c("Trip Type", "2019", "2020",
"2019", "2020", "Total")) %>%
add_header_above(c(" ", "Pre-COVID" = 2, "Post-COVID" = 2, " ")) %>%
row_spec(3, bold = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover",
"condensed", "responsive"))| Trip Type | 2019 | 2020 | 2019 | 2020 | Total |
|---|---|---|---|---|---|
| Inter (Different Tract) | 98.2% | 98.4% | 98.7% | 98.1% | 98.5% |
| Intra (Within Same Tract) | 1.8% | 1.6% | 1.3% | 1.9% | 1.5% |
| Total | 100.0% | 100.0% | 100.0% | 100.0% | 100.0% |
OD Flows, 1000+ Trips
While origin and destination tracts provide a general sense of the geographic pattern of rideshare trips, they do not capture travel flows between areas. The maps below link the beginning and end of trips, where the color and thickness of desire lines vary based on the number of trips made between tracts.
Across the entirety of 2019 and 2020, in both Pre-COVID and Post-COVID periods, the most popular trips were from O’Hare and Midway airports to the Loop, and vice versa. The OD pairs also indicate a high concentration of trips linking the Central Business District to nearby areas like the West Loop, as well as a clear pattern of trips up and down the lakefront. After the Stay-at-Home Order went into effect, trips linking the South lakefront to the Loop and the North Side decreased dramatically.
Neighborhoods with a high concentration of essential workers (33%+) are outlined in black.
# Distribution of OD trip pairs
od_pairs_pct <- od_pairs_comp %>%
st_drop_geometry() %>%
group_by(covid_group, year) %>%
arrange(year, covid_group, desc(trips)) %>%
mutate("trips_pct" = trips / sum(trips),
"trips_pct_agg" = cumsum(trips_pct)) %>%
ungroup()
# 90% of OD trip pairs in all periods >10 trips
od_pairs_tail <- od_pairs_pct %>%
group_by(covid_group, year) %>%
filter(trips_pct_agg < 0.90) %>%
arrange(trips) %>%
slice(1) %>%
ungroup()
# OD flows map (all tracts)
tm_shape(sf_tracts) +
tm_borders() +
tm_shape(od_pairs_comp %>%
filter(trips >= 1000)) +
tm_lines(col = "trips", title = "Trips",
style = "quantile", palette = "viridis",
lwd = "lwd", title.lwd = "Trips",
scale = 40, alpha = 0.5,
legend.lwd.show = FALSE) +
tm_facets(by = c("covid_group", "year"),
free.coords = FALSE,
drop.units = TRUE) +
tm_shape(essential_workers_sf %>%
filter(essential_pct >= quantile(essential_pct,
0.80,
na.rm = TRUE))) +
tm_borders(col = "black", lwd = 2) +
tm_layout(main.title = "Rideshare Trips by Origin-Destination (OD) Pairs\nOD Pairs with 1,000+ Trips",
main.title.position = c("center"),
legend.outside = FALSE,
legend.position = c("left", "bottom"),
legend.width = 1.5,
scale = 2.75)
OD Flows (Excluding Airports), 1000+ Trips
# OD flows map (excluding airports - GEOIDs 17031980000, )
tm_shape(sf_tracts) +
tm_borders() +
tm_shape(od_pairs_comp %>%
filter(trips >= 1000,
!pickup_census_tract %in% c("17031980000",
"17031980100"),
!dropoff_census_tract %in% c("17031980000",
"17031980100"),)) +
tm_lines(col = "trips", title = "Trips",
style = "quantile", palette = "viridis",
lwd = "lwd", title.lwd = "Trips",
scale = 100, alpha = 0.5,
legend.lwd.show = FALSE) +
tm_facets(by = c("covid_group", "year"),
free.coords = FALSE,
drop.units = TRUE) +
tm_shape(essential_workers_sf %>%
filter(essential_pct >= quantile(essential_pct,
0.80,
na.rm = TRUE))) +
tm_borders(col = "black", lwd = 2) +
tm_layout(main.title = "Rideshare Trips by Origin-Destination (OD) Pairs\nOD Pairs with 1,000+ Trips\nExcluding O'Hare, Midway Airports",
main.title.position = c("center"),
legend.outside = FALSE,
legend.position = c("left", "bottom"),
legend.width = 1.5,
scale = 2.75)